home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Lib / fileevent.stk < prev    next >
Encoding:
Text File  |  1996-06-24  |  1.5 KB  |  41 lines
  1. ;;;;
  2. ;;;; f i l e e v e n t . s t k         -- Implement the Tk fileevent commeand
  3. ;;;;                       in term of when-port-{read|writ}able
  4. ;;;;                       For backward compatibility ...
  5. ;;;;
  6. ;;;;
  7. ;;;; Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  8. ;;;; 
  9. ;;;; Permission to use, copy, and/or distribute this software and its
  10. ;;;; documentation for any purpose and without fee is hereby granted, provided
  11. ;;;; that both the above copyright notice and this permission notice appear in
  12. ;;;; all copies and derived works.  Fees for distribution or use of this
  13. ;;;; software or derived works may only be charged with express written
  14. ;;;; permission of the copyright holder.  
  15. ;;;; This software is provided ``as is'' without express or implied warranty.
  16. ;;;;
  17. ;;;;           Author: Erick Gallesio [eg@unice.fr]
  18. ;;;;    Creation date: 16-Jun-1996 22:37
  19. ;;;; Last file update: 25-Jun-1996 00:07
  20.  
  21.  
  22. (define (fileevent file mode . script)
  23.   (define (err)
  24.     (error "fileeevent: bad mode specification ~S.\n(Note: fileevent is obsolete; use when-port-readable or when-port-writable)" mode))
  25.     
  26.   (let ((smode (& mode))
  27.     (fct   #f))
  28.     (cond 
  29.        ((equal? smode "readable") (set! fct when-port-readable))
  30.        ((equal? smode "writable") (set! fct when-port-writable))
  31.        (ELSE               (err)))
  32.     (if (null? script)
  33.     (fct file)
  34.     (let ((s (car script)))
  35.       (cond 
  36.        ((procedure? s)    (fct file s))
  37.        ((string? s)       (if (string=? s "") (fct file #f) (err)))
  38.        (ELSE          (err)))))))
  39.  
  40.  
  41.